home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Yerk 3.6.6 / Module source / Grep < prev    next >
Encoding:
Text File  |  1994-01-02  |  3.8 KB  |  142 lines  |  [TEXT/YERK]
  1. \ Grep - not a true grep. It does not search for full regular expressions
  2. \  but only a string of symbols in the set of terminals.
  3. \ 10/15/84  rw
  4. \  1/18/85  cbd eliminated coded searches in favor of string
  5. \  2/15/86  cdn restrict file names to print only on match
  6. \  9/02/86  cdn Added case sensitivity option
  7. \  9/16/86  cdn Added text highlighting: bold line #, underline match, --more--
  8. \  9/20/86  cdn Added tab expansion
  9. \ 12/29/90    rfl modified for sarray path
  10. \  5/19/92    rfl now exits more gracefully, and doesn't search yerk folder unless specified
  11. \  1/01/94    rfl    ffcb clrfcb changed to clear: ffcb; Also sped search up by searching entire
  12. \                  file first..if string found, then search the traditional way.
  13. \                Also, added save to logfile in dialog; changed pause? to process events
  14. \
  15. \ "grflgs" bits:
  16. \ 0 - case sensitive
  17. \ 1 - save to logfile
  18. \ 2 - pause for screen full
  19.  
  20. :Module grepMod
  21.  
  22. // vol
  23. forget dir
  24.  
  25. String gpattern
  26. String linBuf
  27. String target
  28. 0 value curLin#
  29. 0 value #lines
  30. 0 value kBytes
  31. 0 value #files
  32.  
  33. \ pause output if option being used
  34. : more
  35.     grflgs 04 and
  36.     IF    curLin# ?lines 3 - >=
  37.         IF    1 tFace ." --More--" 0 tFace key drop CR
  38.             0 -> curLin#
  39.         THEN
  40.     THEN ;
  41.  
  42. false value getOut
  43. : pause? false -> getOut
  44.     next: fevent
  45.     IF 2drop cr .pause (key) cr 0 -> out 32 >
  46.             IF true ELSE false THEN
  47.     ELSE false
  48.     THEN -> getOut 
  49.      ;
  50.  
  51. \ ( -- ) ( VARS: linecount, mybuf )  n.b. also assumes gpattern set
  52. : SearchFile  { \ line# .name? -- } pause?
  53.     1 ++> #files
  54.     topfile size: topfile read: linBuf drop
  55.     size: topfile ++> KBytes
  56.     grflgs 01 and 0= IF uc: linBuf 2drop THEN
  57.     start: linBuf get: gpattern indexOf: linBuf
  58.     IF drop
  59.         0 moveto: topfile drop
  60.         0 -> line#  1 -> .name?
  61.         BEGIN    pause?
  62.             topFile 80 readLine: linBuf not getOut not and
  63.         WHILE
  64.             1 ++> line#
  65.             target =: linBuf  start: target
  66.             grflgs 01 and 0= IF uc: target 2drop THEN
  67.             get: gpattern  indexOf: target
  68.             IF    .name?
  69.                 IF  more cr getName: topFile type ." :" cr 2 ++> curLin#
  70.                     0 -> .name?
  71.                 THEN
  72.                 more
  73.                 1 tFace    \ bold
  74.                 line# 3 .r ." ->" start: linBuf
  75.                 0 tFace    \ plain
  76.                 dup substr: linBuf type
  77.                 4 tFace    \ underline
  78.                 dup moveTo: linBuf
  79.                 size: gpattern dup substr: linBuf type
  80.                 + dup moveTo: linBuf
  81.                 0 tFace    \ plain
  82.                 size: linBuf swap - substr: linBuf type cr 1 ++> curLin#
  83.             THEN
  84.         REPEAT
  85.         line# ++> #lines
  86.     THEN
  87. ;
  88.  
  89. \ GREP - Will search through all text
  90. \  files for the string specified in object gpattern; printing out the
  91. \  file name, line number and line for all occurrences of the string it
  92. \  locates.
  93. : (grep)  { addr len \ gcurs dirid -- }
  94.     grFlgs 02 and IF +file THEN
  95.     false -> getOut
  96.     watchcurs 0 -> #lines 0 -> curLin# 0 -> kBytes 0 -> #files
  97.     curs -> gcurs -curs    \ Preserve cursor status
  98.     new: loadFile  new: gpattern new: target
  99.     addr len str255 -base count put: gPattern
  100.     ." Searching for: " print: gPattern CR
  101.     grflgs 01 and IF ." -Case sensitive-" CR
  102.                 ELSE uc: gPattern 2drop THEN
  103.     new: linBuf
  104.     HFS? IF limit: path ELSE 1 THEN 0
  105.     DO    path IF i at: path  name: fFcb
  106.               ELSE clear: fFcb
  107.               THEN
  108.         i at: path swap drop 0>
  109.         IF  Filecount 1+ 1
  110.             DO    i getidxfile
  111.                 IF    pad count " System" s= not
  112.                     IF    pad count name: topFile
  113.                         getdirid: ffcb setdirid: topfile
  114.                         openReadOnly: topFile ?error 132
  115.                         GetFileInfo: topFile  drop
  116.                         GetType: topFile txType =
  117.                         IF    searchfile THEN
  118.                         close: topFile drop
  119.                     THEN
  120.                 THEN
  121.         getOut IF Leave THEN
  122.         LOOP
  123.         getOut IF Leave THEN
  124.         THEN
  125.     LOOP
  126.     gcurs -> curs    \ Restore cursor status
  127.     remove: loadFile release: gpattern release: target
  128.     release: linBuf
  129. \    cr #lines . ." lines searched." cr
  130.     cr #files . ." files, "
  131.     kBytes 1000000 >
  132.         IF   kBytes 1000 / 0 <# # # # ascii . hold #s #> type ."  MBytes"
  133.         ELSE kBytes  100 / 0     <# # ascii . hold #s #> type ."  KBytes"
  134.         THEN ."  searched." cr 
  135.     arrowcurs
  136.     grFlgs 02 and IF -file THEN
  137. ;
  138.  
  139. : grep word" count (grep) ;
  140.  
  141. ;Module
  142.